(defmeth histofreq-proto :ask-save-pdf ()
  (save-pdf-histofreq self))

( provide "pdfplot" )


(defun save-pdf-histofreq (plot &key (theme 'fancy) (back-color 'grey) (backgrid t) (print-title t) (print-variable t)(font "Arial") (type-font "Type1"))

( defproto pdf-plot '( output ) () plot)

  ( defmeth pdf-plot :line-width (&optional (val nil set))
    (when val (setf pdf-val (/ val 4)));lines thicker!
	( when set 
		( format (slot-value 'output) " ~d w " pdf-val ) ;PV makes line thinner
        (if (send temp-proto :has-method :line-width :own t)
            (send self :apply-old-method ':line-width val)
            (call-next-method val))
        )
    (if (send self :apply-old-method ':line-width)
        (send self :apply-old-method ':line-width)
        (call-next-method))
    )

  ( defmeth pdf-plot :line-type (&optional (val nil set))
   	(when set
        		(if (eq val 'DASHED)
			(format (slot-value 'output) " [ 3 5 ] 0 d " ) 	; 'DASHED
           			(format (slot-value 'output) " [ ] 0 d " ))	; else 'SOLID 
         (if (send temp-proto :has-method :line-type :own t)
             (send self :apply-old-method ':line-type)
             (call-next-method))
    ))
 	
                                ( defmeth pdf-plot :draw-color (&optional (val nil set))
   	( when (and set val)
          (if  (send temp-proto :has-method :draw-color :own t)
               (send self :apply-old-method ':draw-color  val)
         		(call-next-method val))
         		( format (slot-value 'output) "~{ ~f ~} RG ~{ ~f ~} rg "
                    (if 
                     ( parse-color val )
                     (parse-color val) 
                     (list 1  1 1))
                       (if 
                     ( parse-color val )
                     (parse-color val) 
                     (list 1  1 1))))

  	 (if  (send temp-proto :has-method :draw-color :own t)
         (send self :apply-old-method ':draw-color)
       		(call-next-method))
    )
  
  ( defmeth pdf-plot :draw-line (x0 y0 x1 y1)
    (if  (send temp-proto :has-method :draw-line :own t)
         (send self :apply-old-method ':draw-line  x0 y0 x1 y1)
        	( call-next-method x0 y0 x1 y1 ))
   	( format (slot-value 'output) 
           		"~d ~d m ~d ~d l S ~%" x0 y0 x1 y1 ))

  ( defmeth pdf-plot :draw-symbol (symb hi x y)  
     (if  (send temp-proto :has-method :draw-symbol :own t)
          (send self :apply-old-method ':draw-symbol  symb hi x y)
         	( call-next-method symb hi x y ))
    
    ( format (slot-value 'output) " ~d w " .25)
    
 (cond ((equal symb 'CROSS)
             (let ((x (- x 0))
                   (y (- y 0)))
             (cond ((not hi)
                    ( format (slot-value 'output) 
                           		"~d ~d m ~d ~d l ~d ~d m ~d ~d l s  ~%" x (+ 1.25 y) x (- y 1.25) (+ x 1.25) y (- x 1.25) y))
               (hi 
                ( format (slot-value 'output) 
                       		"~d ~d m ~d ~d l ~d ~d m ~d ~d l s  ~%" x (+ 1 y) x (- y 1) (+ x 1) y (- x 1) y)
                (send self :draw-disk-symbol x y 2 2 nil)))))
        ((equal symb 'DIAMOND)
         (let ((x (- x 0))
               (y (- y 0)))
         ( format (slot-value 'output) 
                		"~d ~d m ~d ~d l ~d ~d l ~d ~d l ~d ~d l ~A ~%" (- x 1) y x (+ y 1) 
                  (+ x 1) y x (- y 1) (- x 1) y ( if hi "f" "S"  ))))
        ((equal symb 'X)
         (let ((x (- x 0))
               (y (- y 0)))
           (cond ((not hi)
                  ( format (slot-value 'output) 
                         		"~d ~d m ~d ~d l ~d ~d m ~d ~d l ~A ~%" (- x 1) (+ y 1) (+ x 1) (- y 1) 
                           (- x 1) (- y 1) (+ 1 x) (+ y 1) ( if hi  "f" "S")))
             (hi ( format (slot-value 'output) 
                        		"~d ~d m ~d ~d l ~d ~d m ~d ~d l s ~%" (- x .75) (+ y .75) (+ x .75) (- y .75) 
                          (- x .75) (- y .75) (+ x .75) (+ y .75))
                 (send self :draw-disk-symbol x y 2 2 nil)))))
        ((equal symb 'DOT)
         ( format (slot-value 'output)                                                                                                              		" ~d ~d m ~d ~d .5 .5 re ~A ~%" (- x 0.25) (- y -.25) (- x .25) (- y .25) ( if hi  "f" "S" )))
        ((equal symb 'DISK)
         (setf currcolor (send self :draw-color))
        (send self :draw-color (send self :back-color))
         
         (send self :paint-oval (- x 1) (- y 1) 2 2 )
         (send self :draw-color currcolor)
         (send self :frame-oval (- x 1) (- y 1) 2 2 )
          ;was (send self :draw-disk-symbol (- x 0) (- y 0) 1.5 1.5 hi)
        
         )
        (t 
         (setf currcolor (send self :draw-color))
         (send self :draw-color (send self :back-color))
         ;( format (slot-value 'output)                                                                                                              		;" ~d ~d m ~d ~d 1.5 1.5 re ~A ~%" (- x 0.75) (- y 0.75) (- x 0.75) (- y 0.75) 
                   ;( if hi  "f" "f\n" ))
         (send self :paint-rect (- x 1) (- y 1) 2 2 )
         (send self :draw-color currcolor)
         (send self :frame-rect (- x 1) (- y 1) 2 2 )

        ))
    ( format (slot-value 'output) " ~d w " (send self :line-width)))
  
  ( defmeth pdf-plot :draw-string ( str x y )
    (if  (send temp-proto :has-method :draw-string :own t)
         (send self :apply-old-method ':draw-string  str x y )
        	(call-next-method str x y ))
    
   	(format (slot-value 'output) "BT 1 0 0 -1 0 0 Tm ~d ~d Td (~A) Tj ET~%" 
                                      			 x (- y) str ))
                                
  ( defmeth pdf-plot :draw-string-up ( str x y )
    (if  (send temp-proto :has-method :draw-string-up :own t)
         (send self :apply-old-method ':draw-string-up  str x y )
        	(call-next-method str x y))
   	(format (slot-value 'output)
          	 "BT 0 -1 -1 0 0 0 Tm ~d ~d Td (~A) Tj ET~%" 
          	 (- y) (- x) str ))
  
  
  ( defmeth pdf-plot :draw-text ( str x y h v )
   	(if ( = h 1) 
      		(setf x (- x (floor ( / ( send self :text-width str) 2))))
      		(if ( = h 2)
         			(setf x (- x (send self :text-width str)))))
   	(if ( = v 1) 
      		(setf y (+ y  (send self :text-ascent))))
   	(send self :draw-string str x y ))
  
  ( defmeth pdf-plot :draw-text-up ( str x y h v )
   	(if (= h 1)
      		(setf y (+ y (floor 
                   			(/ (send self :text-width str) 2 )))))
   	( setf x ( + x  (send self :text-ascent)))
   	(send self :draw-string-up str x y ))
  
  ( defmeth pdf-plot :frame-rect ( x0 y0 x1 y1 )
    (if  (send temp-proto :has-method :frame-rect :own t)
         (send self :apply-old-method ':frame-rect  x0 y0 x1 y1)
        	(call-next-method x0 y0 x1 y1))

   	(format (slot-value 'output)
          		"\n ~d ~d ~d ~d re S\n" x0 y0 x1 y1 ))
  
  ( defmeth pdf-plot :paint-rect ( x0 y0 x1 y1 )
     (if  (send temp-proto :has-method :paint-rect :own t)
          (send self :apply-old-method ':paint-rect  x0 y0 x1 y1)
         	(call-next-method x0 y0 x1 y1))
    
   	(format (slot-value 'output)
          		"\n ~d ~d ~d ~d re f\n" x0 y0 x1 y1 ))
		
  ( defmeth pdf-plot :make-poly ( points  &optional (from-origin t))
   	( let (( output (slot-value 'output)))
   			(format output " n ~d ~d m " (first (car points)) (second (car points)))
    		( dolist ( pt points )
			(format output " ~d ~d l " (first pt) (second pt)))))
 	
  ( defmeth pdf-plot :frame-poly ( points &optional (from-origin t))
    (if  (send temp-proto :has-method :frame-poly :own t)
          (send self :apply-old-method ':frame-poly points from-origin)
        	(call-next-method points from-origin))
   	(send self :make-poly points from-origin)
	(format (slot-value 'output) " S ~%" ))
  
  ( defmeth pdf-plot :paint-poly ( points &optional (from-origin t))
    (if  (send temp-proto :has-method :paint-poly :own t)
         (send self :apply-old-method ':paint-poly points from-origin)
        	(call-next-method points from-origin))
   	(send self :make-poly points from-origin)
   	(format (slot-value 'output) " f ~%" ))	
  
 ( defmeth pdf-plot :draw-disk-symbol ( x0 y0 w h hi)
   (let* (
          (x0 (- x0 (/ w 2)))
          ;(y0 (- y0 (/ h 2)))
          (h (* h (/ 2 3)))
         (w (/ w 2))
         (x0 (+ x0 (/ w 2)))
         (y0 y0))
   (format (slot-value 'output) " n ~d ~d m ~%" (- x0 (/ w 2)) y0)
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c ~% " 
           (- x0 (/ w 2))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           y0 )
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c ~A ~%" 
           (+ x0 (+ (/ w 2) w))
           (- y0 h)
           (- x0 (/ w 2)) 
           (- y0 h)
           (- x0 (/ w 2)) 
           y0
           ( if hi "f"  "S"   ))
           ))
 	
 ( defmeth pdf-plot :frame-oval ( x0 y0 w h )
    (if  (send temp-proto :has-method :frame-oval :own t)
         (send self :apply-old-method ':frame-oval x0 y0 w h)
         (call-next-method x0 y0 w h))
     
   (let* (
          (y0 (+ y0 (/ h 2)))
          (h (* h (/ 2 3)))
          (w (/ w 2))
          (x0 (+ x0 (/ w 2)))
          )
         
   (format (slot-value 'output) " n ~d ~d m ~%" (- x0 (/ w 2)) y0)
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c ~% " 
           (- x0 (/ w 2))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           y0 )
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c S ~%" 
           (+ x0 (+ (/ w 2) w))
           (- y0 h)
           (- x0 (/ w 2)) 
           (- y0 h)
           (- x0 (/ w 2)) 
           y0 )
           ))

( defmeth pdf-plot :paint-oval ( x0 y0 w h )
    (if  (send temp-proto :has-method :paint-oval :own t)
         (send self :apply-old-method ':paint-oval x0 y0 w h)
         (call-next-method x0 y0 w h))
     
   (let* (
          (y0 (+ y0 (/ h 2)))
          (h (* h (/ 2 3)))
          (w (/ w 2))
          (x0 (+ x0 (/ w 2)))
          )
         
   (format (slot-value 'output) " n ~d ~d m ~%" (- x0 (/ w 2)) y0)
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c ~% " 
           (- x0 (/ w 2))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           (+ y0 h)
           (+ x0 (+ (/ w 2) w))
           y0 )
   (format (slot-value 'output)
          		"\n ~d ~d ~d ~d ~d ~d c f ~%" 
           (+ x0 (+ (/ w 2) w))
           (- y0 h)
           (- x0 (/ w 2)) 
           (- y0 h)
           (- x0 (/ w 2)) 
           y0 )
           ))
  
 ( defmeth pdf-plot :draw-data-lines ( var1 var2 m n)
   	( format (slot-value 'output) "\n%% :DRAW-DATA-LINES\n" )
    (let 	((nv (send self :num-variables))
           (nl (send self :num-lines))
           (nj (iseq m n)))        
      (when 
       (or (not (< -1 var1 nv)) (not (< -1 var2 nv)))
       (error "Vars: ~A not between 0 and ~d (:num-variables)" 
              (list var2 var2) nv))
      (when 
       (or  (< m 0) (>= n nl))
       (error "index ~a out of range ~a" (list m n) (list 0 nl)))
      
      (let ((save-width (send self :line-width))		 ; save graphics state
            (save-color (send self :draw-color))
            (save-type (send self :line-type))
            (content-rect (send self :content-rect))) ; to correct for origin
        
        (let* ((widths 	(send self :linestart-width nj))
               (widths (/ widths 0.5)) ;PV makes lines thiner
               (types 	(send self :linestart-type nj))
               (colors 	(send self :linestart-color nj))
               (usecolor (send self :use-color))
               (masked (send self :linestart-masked nj))
               (xsys (mapcar #'(lambda (n) (send self :scaled-to-canvas 
                                                      (send self :linestart-transformed-coordinate var1 n)
                                                      (send self :linestart-transformed-coordinate var2 n)
                                                      ))
                             nj));for printing spinplots
               (xs (if (member spin-proto (send self :precedence-list))
                       (mapcar #'(lambda (pt) (select pt 0)) xsys)
                       (+ (first content-rect)
                   	 (send self :linestart-canvas-coordinate var1 nj))
                       ))
                       ;the first part of the if is for spinplots
               (ys (if (member spin-proto (send self :precedence-list))
                       (mapcar #'(lambda (pt) (select pt 1)) xsys)
                       (- (fourth content-rect)  (- (second content-rect))
                    	         (send self :linestart-canvas-coordinate var2 nj))
                       ))
               )

      (dotimes (i (length nj))
              	( let (( nexti ( send self :linestart-next i)))
                 (when (and nexti (not (elt masked i)))
                       (when (and usecolor (elt colors i)) 
                             (send self :draw-color (elt colors i)))
                       (send self :line-width (elt widths i))
                       (send self :line-type  (elt types i))
                      (when (not (equal (send self :draw-color) 'blue));avoids drawing the histogram bars again
                            (send self :draw-line 
                             (elt xs i) (elt ys i)
                             (elt xs nexti) (elt ys nexti))
                       )))))

        (send self :line-width save-width)	; restore graphics state
        (send self :draw-color save-color)
        (send self :line-type save-type)))
    (if (send temp-proto :has-method :draw-data-lines :own t)
        (send self :apply-old-method ':draw-data-lines var1 var2 m n)
        (call-next-method var1 var2 m n))
    
    (values)
   	)
 	
  ( defmeth pdf-plot :redraw-background ()
   	( format (slot-value 'output) "\n%% :REDRAW-BACKGROUND\n" )
    (let ((dc (send self :draw-color)))
   	  (send self :draw-color (send self :back-color))
   	  (apply #'send self :paint-rect (send self :clip-rect))
   	  (send self :draw-color dc)
   	  (when (send self :has-method :grid-color)		;; backgrid mods included ? 
        	  	(let (( color ( send self :grid-color )))
             	(if color  (send self :draw-grid :color color))
           	 	(if color  (send self :draw-zero-axis :color color))))
      (send self :draw-color dc))

        (if (send temp-proto :has-method :redraw-background :own t)
        (send self :apply-old-method ':redraw-background)
        (call-next-method))
      )
  
 ( defmeth pdf-plot :redraw-axis ()
 	 ( format (slot-value 'output) "\n%% :REDRAW-AXIS\n" )
   (let   ((xrange (send self :range (first (send self :current-variables))))
      		   (yrange (send self :range (second (send self :current-variables))))
      		   (xaxis  (send self :x-axis))
      		   (yaxis  (send self :y-axis))
           )
     (when (or (first xaxis) (first yaxis))
           (send self :draw-ticks-x)
           (send self :draw-ticks-y)
           (send self :draw-back-rectangle)
           (send self :write-x-cutpoints)
           (send self :write-y-cutpoints)
           (send self :write-variable-names)
             ;(send self :line-width lw) 
            ; (send self :draw-color c)
           )))

(defmeth pdf-plot :write-variable-names ()
  (let* (
         (x0 (first (send self :content-rect)))
         (xw (third (send self :content-rect)))
         (y0 (second (send self :content-rect)))
         (yt (fourth (send self :content-rect)))
         (xcenter (round (mean (list x0 (+ x0 xw)))))
         (ycenter (round (mean (list y0 (+ y0 yt)))))
         )
    (when print-variable 
          (send self :draw-text
                (send self :variable-label 
                      (first (send self :current-variables)))
                xcenter (+ y0 yt 30) 1 0)
          (send self :draw-text-up 
                  "Frequency" ;was (send self :variable-label (second (send self :current-variables)))
                   (- x0 40) ycenter  1 0)
          )))

(defmeth pdf-plot :draw-back-rectangle (&optional (drwcolor 'grey))
  (let* (
         (drwcolor drwcolor)
         (x0 (first (send self :content-rect)))
         (y0 (- (second (send self :content-rect)) 5))
         (xw (third (send self :content-rect)))
         (yh (+ (fourth (send self :content-rect)) 5))
         (currentdrawcolor (send self :draw-color))
         (currentlinewidth  (send self :line-width))
         )

    (send self :draw-color drwcolor)
    (send self :paint-rect 
          x0
          y0
          xw
          yh)

    (send self :draw-grid)

    (send self :draw-color 'black)
    (send self :line-width 2)
    (send self :frame-rect 
                   x0
                   y0
                   xw
                   yh)
          (send self :draw-color currentdrawcolor)
          (send self :line-width currentlinewidth)
         ))

(defmeth pdf-plot :draw-grid (&optional (drwcolor 'white) (lw 2))
  (when backgrid
        (let* (
               (lw lw)
               (drwcolor drwcolor)
               (yrange (send self :range (second (send self :current-variables))))
               (yaxis  (send self :y-axis))
               (rys (rseq (first yrange) (second yrange) (third yaxis)))
               (x0 (first (send self :content-rect)))
               (xend (+ x0 (third (send self :content-rect))))
               (y-ticks  (mapcar #'(lambda (y) (second (send self :real-to-canvas 0 y)))
                          					rys ))
               (xrange (send self :range (first (send self :current-variables))))
               (x-axis (send self :x-axis))
               (rxs (rseq (first xrange) (second xrange) (third x-axis)))
               (y0 (second (send self :content-rect)))
               (yend (+ x0 (third (send self :content-rect))))
               (x-ticks  (mapcar #'(lambda (x) (first (send self :real-to-canvas x 0)))
                          					rxs ))
               (currentdrawcolor (send self :draw-color))
               (currentlinewidth  (send self :line-width))
               )
          (send self :draw-color drwcolor)
      (mapcar #'(lambda (i j)
                  ;(send self :line-width (/ lw 2)) 
                  ;(setf ymid (round (/ (+ i j) 2)))
                  ;(send self :draw-line x0 ymid xend ymid)
                      (send self :line-width lw)
                      (send self :draw-line x0 i xend i))
              (butfirst  y-ticks) (butlast y-ticks))
       #|   (mapcar #'(lambda (i j)
       (send self :line-width (/ lw 2))
      (setf xmid (round (/ (+ i j) 2)))
       (send self :draw-line xmid y0  xmid yend)
                      (send self :line-width lw)
                      (send self :draw-line  i y0 i yend))
               (butfirst  x-ticks) (butlast x-ticks))|#
          (send self :draw-color currentdrawcolor)
          (send self :line-width currentlinewidth)
          )))
(defmeth pdf-plot :draw-ticks-x ()
  (let* (
         (cut-points (mapcar #'(lambda (x) (select (send self :real-to-canvas x 0) 0))
                            (send self :cut-points)))
         (y0 (second (send self :real-to-canvas 0 0)))
         (currentdrawcolor (send self :draw-color))
         (currentlinewidth  (send self :line-width))
        )
    (send self :draw-color 'black)
    (send self :line-width 2)
    (mapcar #'(lambda (i)
                (send self :draw-line i y0 i (+ y0 4)))
            cut-points)
    (send self :draw-color currentdrawcolor)
    (send self :line-width currentlinewidth)
    ))

(defmeth pdf-plot :draw-ticks-y ()
  (let* (
         (yrange (send self :range (second (send self :current-variables))))
       	 (yaxis  (send self :y-axis))
         (rys (rseq (first yrange) (second yrange) (third yaxis)))
         (x0 (first (send self :content-rect)))
         (y-ticks  (mapcar #'(lambda (y) (second (send self :real-to-canvas 0 y)))
                          					rys ))
         (currentdrawcolor (send self :draw-color))
         (currentlinewidth  (send self :line-width))
         )
    (send self :draw-color 'black)
    (send self :line-width 2)
        (mapcar #'(lambda (i)
                (send self :draw-line x0 i (- x0 4) i))
            y-ticks)
    (send self :draw-color currentdrawcolor)
    (send self :line-width currentlinewidth)
    ))
 
(defmeth pdf-plot :write-x-cutpoints ()
      (let* (
             (cut-points (send self :cut-points))
             (ntics (length cut-points))
             (cut-points-pos-x (mapcar #'(lambda (x) (select (send self :real-to-canvas x 0) 0))
                                     (send self :cut-points)))
             (y0 (- (select (send self :real-to-canvas 0 0) 1) 0))
             (formatick "~3,1g")
             )
        (cond 
          ((every #'equal (repeat t (length cut-points)) 
                  (mapcar #'(lambda (number) (= 0 (- number (truncate number))))  cut-points))
           (setf formatick "~D")
           (setf cut-points (mapcar #'(lambda (numb) (setf numb (truncate numb))) cut-points))
               )
          ((> (max cut-points) 1000) 
            (setf formatik "~3,1g"))
          (t  (setf formatick "~3,1f")
              )
          )
        (mapcar #'(lambda (x xpos i) 
                    (when (oddp i) 
                          (send self :draw-text (format nil formatick x)
                                (+ xpos 4) (+ y0  (send self :text-ascent) 2)  1 0))
                    (when (evenp i)
                          (when (< ntics 8 )
                                (send self :draw-text (format nil formatick x)
                                      (+ xpos 4) (+ y0  (send self :text-ascent) 2)  1 0)))
                    )
                cut-points cut-points-pos-x (iseq ntics))
               ))
  (defmeth pdf-plot :write-y-cutpoints ()
    (let* (
           (yrange (send self :range (second (send self :current-variables))))
           (yaxis  (send self :y-axis))
           (rys (rseq (first yrange) (second yrange) (third yaxis)))
           (x0 (first (send self :content-rect)))
           (y-ticks  (mapcar #'(lambda (y) (second (send self :real-to-canvas 0 y)))
                          					rys ))
           (formatick)
           )
      (cond
        ((every #'equal (repeat t (length rys)) 
                (mapcar #'(lambda (number) (= 0 (- number (truncate number))))  rys))
         (setf formatick "~D")
         (setf rys (mapcar #'(lambda (numb) (setf numb (truncate numb))) rys))
         )
        (t  (setf formatick "~3,1f")
            )
        )
        (mapcar #'(lambda (ry ypos) (send self :draw-text-up (format nil formatick ry)
                                    (- x0 (+ 7 (send self :text-ascent))) (- ypos 2)  1 0))
                   rys y-ticks)
            ))

(defmeth pdf-plot :draw-bars ()
  (let* (
         (counts (mapcar #'(lambda (y) (select (send self :real-to-canvas 0 y) 1))
                        (send self :counts)))
         (cut-points (mapcar #'(lambda (x) (select (send self :real-to-canvas x 0) 0))
                            (send self :cut-points)))
         (currentdrawcolor (send self :draw-color))
         (currentlinewidth  (send self :line-width))
        )

    (send self :draw-color 'blue)
    (mapcar #'(lambda (index i j) 
                  
                  (send self :paint-rect 
                        i
                        (select (send self :real-to-canvas j 0) 1)
                        (- (select cut-points index) i)
                        (- j (select (send self :real-to-canvas i 0) 1))
                        ))
            (butfirst (iseq (length cut-points)))    (butlast cut-points) counts)

    (send self :draw-color 'black)
    (send self :line-width 2)
    (mapcar #'(lambda (index i j) 
                
                 (send self :frame-rect 
                       i
                       (select (send self :real-to-canvas j 0) 1)
                       (- (select cut-points index) i)
                       (- j (select (send self :real-to-canvas i 0) 1))
                       ))
              (butfirst (iseq (length cut-points)))  (butlast cut-points) counts)
    (send self :draw-color currentdrawcolor)
    (send self :line-width currentlinewidth)
    )
  )

( defmeth pdf-plot :redraw-content ()
    ( format (slot-value 'output) "\n%% :REDRAW-CONTENT\n" )
    
    (let ((cv (send self :current-variables))
          (nl (send self :num-lines))
          (np (send self :num-points)))

      (send self :redraw-axis)

            (when (> np 0)
            (send self :draw-bars)
            )
      (when (> (send self :num-lines) 0)
            (send self :draw-data-lines (first (send self :current-variables)) 
                  (second (send self :current-variables)) 0 (1- (send self :num-lines))))

      ;; actually, this (below) seems to be done in draw-data-points
     (when (and (send self :showing-labels) 
                 (send self :has-method :draw-data-strings)) 
            (send self :draw-data-strings))
      )
   	)

  (defmeth pdf-plot :redraw-overlays ()
    ) 
  (defmeth pdf-plot :legend2 (&optional legend2)
   "" )
  (defmeth pdf-plot :legend1 (&optional legend1)
      "")

(defmeth pdf-plot :redraw ()
  (if (send temp-proto :has-method :redraw :own t)
        (send self :apply-old-method ':redraw)
        (call-next-method)))

 	(defmeth pdf-plot :resize ()
    (if (send temp-proto :has-method :resize :own t)
        (send self :apply-old-method ':resize)
        (call-next-method)))

  (defmeth pdf-plot :apply-old-method (method &rest args)
    "This method works like a call-next-method but :own-methods are not skipped"
    (when (send temp-proto :has-method method :own t)
          (send temp2-proto :add-method method (send self :get-method method))
          (send self :delete-method method)
           (when (send temp2-proto :has-method method :own t) 
                 (send self :add-method method (send temp-proto :get-method method))
                 (if args (send self method args) (send self method)) )
          (when (send temp2-proto :has-method method :own t) 
                (send self :delete-method method)
                (send self :add-method method (send temp2-proto :get-method method)))))

  ;; Values for MediaBox need to be supplied:
;;   /MediaBox [ ~d ~d ~d ~d ]  
  
  ( setf pdf-header  
         "%PDF-1.0
% Graphics output produced by xlispstat & pdfplot.lsp. 
" )
  
  ( setf pdf-objects 
         (list
          "1 0 obj
<<
/Type /Catalog
/Pages 3 0 R
/Outlines 2 0 R
>>
endobj
"
          
          "2 0 obj
<<
/Type /Outlines
/Count 0
>>
endobj
"
          
"3 0 obj
<<
/Type /Pages
/Count 1
/Kids [ 7 0 R ]
>>
endobj
"
          
"4 0 obj
[
/PDF /Text
]
endobj
"

(format () "5 0 obj
<< 
/Type /Font 
/Subtype /~A
/Name /F1
/BaseFont /~A
/Encoding /MacRomanEncoding
>>
endobj
"
type-font font)

"6 0 obj
<< 
/Type /Font 
/Subtype /Type1
/Name /F2
/BaseFont /ZapfDingbats
/Encoding /MacRomanEncoding
>>
endobj
"

"7 0 obj
<<
/Type /Page
/Parent 3 0 R
/Resources << /Font << /F1 5 0 R   /F2 6 0 R  >>   /ProcSet 4 0 R >>
/MediaBox [ ~d ~d ~d ~d ]
/Contents 8 0 R
>>
endobj
" ))


  ( setf pdf-stream ( list 
                      
"8 0 obj
<< /Length 9 0 R >>
stream
%
BT
/F1 9 Tf
ET
%
% Begin Lisp graphics output
%
~A
%
% End Lisp graphics output 
%
endstream
endobj
"
                      
                      
"9 0 obj
 ~d 
endobj
"
 ))

 


( setf pdf-trailer-template
"xref
0 10
0000000000 65535 f
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
~10,48d 00000 n
trailer
<<
/Size 11
/Root 1 0 R
>>
startxref
~d
%%EOF
" )


( defun make-pdf-string ( graph-pdf &optional (output nil output-assigned))
  ;first save the owner methods of the plot
  (setf temp-proto (make-object))
  (setf temp2-proto (make-object))
  ( dolist ( meth ( send graph-pdf :own-methods ))
         		( send temp-proto :add-method meth ( send graph-pdf :get-method meth )))
  ;second put the pdf methods in plot 
	( dolist ( meth ( send pdf-plot :own-methods ))
		( send graph-pdf :add-method meth ( send pdf-plot :get-method meth )))


	(if (null output-assigned) (setf output (make-string-output-stream)))
	( send graph-pdf :add-slot 'output output )
	( format output "1 0 0 -1 0 ~d cm ~%" ( second ( send graph-pdf :size )))
	( send graph-pdf :redraw )

;third delete the pdf methods from plot
	( dolist ( meth ( send pdf-plot :own-methods ))
		( send graph-pdf :delete-method meth ))

;fourth add the old plots to plot
  ( dolist ( meth ( send temp-proto :own-methods ))
         		( send graph-pdf :add-method meth ( send temp-proto :get-method meth )))
  
  (send graph-pdf :redraw) ;rebuilds the plot

 	(if (null output-assigned) (get-output-stream-string output)
						output ))

(write-pdf plot )

  plot)